
; User Interface Class
; accepts and draws drawables
; adds/deletes controllers and notifies them on keyboard events


(define user-interface%
  (class object%
    
    ; HELPER CLASSES
    ; Canvas subclass that handles keyboard input events
    (define user-interface-canvas%
      (class canvas%
        (super-new)
        ; Keyboard events
        (define/override (on-char event)
          ; Get code/pressed and notify controllers
          (let ((key (send event get-key-code))
                (pressed #t))
            (when (eq? key 'release)
              (set! key (send event get-key-release-code))
              (set! pressed #f))
            (mfor-each (lambda (controller) (send controller controller-input key pressed)) controllers)))))
    
    ; Frame subclass that handles top level window events
    (define user-interface-frame%
      (class frame%
        (super-new)
        ;(inherit center)
        (define/augment (on-close)
          (destroy))))
    
    
    
    ; PRIVATE VARIABLES
    (define quit #f)
    (define controllers '())
    (define frame  (new user-interface-frame%
                        [label *app-name*]
                        [stretchable-width  #f]
                        [stretchable-height #f]))
    (define canvas (new user-interface-canvas% [parent frame]))
    (define dc     (send canvas get-dc))
    (define buffer #f)
    
    
    
    ; Quit?
    (define/public (quit?)
      quit)
    
    ; Destroy window
    (define/public (destroy)
      (set! quit    #t)
      (send frame show #f))
    
    
    ; Add Controller
    (define/public (add-controller controller)
      (set! controllers (mcons controller controllers)))
    ; Remove Controller
    (define/public (remove-controller controller)
      (set! controllers (mremove controller controllers)))
    
    
    
    ; Draw
    (define/public (render renderable)
      (let ([width  (send renderable get-width )]
            [height (send renderable get-height)])
        ; Set frame size
        (send frame min-width  width)
        (send frame min-height height)
        ; (re)create framebuffer if it does not exist or have the wrong dimensions
        (unless (and buffer (eq? width (send (send buffer get-bitmap) get-width)) (eq? height (send (send buffer get-bitmap) get-height)))
          (set! buffer (make-object bitmap-dc% (make-object bitmap% width height)))
          (send frame center 'both)
          (send frame show #t)
          (send canvas focus))
        ; Draw to buffer
        (send renderable draw buffer)
        ; Render buffer
        (send dc draw-bitmap (send buffer get-bitmap) #i0 #i0)))
    
    ; Constructor/Initialization
    (super-new)))

